home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1986 November & December / rerun-1986-11-12.d64 / peg solitaire (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  13KB  |  320 lines
  1. 10 rem - pegsol.081785
  2. 20 dim a$(3),b(37),c$(16),c(37)
  3. 30 rs=828:fora=rs to859:readb:pokea,b:next:rem selective restore
  4. 31 data32,253,174,32,158,173,32,247,183,32,19,166,176,5,162,17,76,55,164
  5. 32 data165,95,233,1,133,65,165,96,233,0,133,66,96
  6. 40 print"[147]":poke53280,14:poke53281,6:u$="[145]":w$="":goto1665
  7. 49 rem - cursor rtn
  8. 50 ifdy=1then dy=7:pokevv+3,208:ys=208:return
  9. 51 ifdy=2and(dx=2ordx=6)then dy=6:pokevv+3,184:ys=184:return
  10. 52 ifdy=3and(dx=1ordx=7)then dy=5:pokevv+3,160:ys=160:return
  11. 53 ys=ys-24:dy=dy-1:pokevv+3,ys:return
  12. 60 ifdy=5and(dx=1ordx=7)then dy=3:pokevv+3,112:ys=112:return
  13. 61 ifdy=6and(dx=2ordx=6)then dy=2:pokevv+3,88:ys=88:return
  14. 62 ifdy=7then dy=1:pokevv+3,64:ys=64:return
  15. 63 ys=ys+24:dy=dy+1:pokevv+3,ys:return
  16. 70 pokevv+16,2:ifdx=1then dx=7:pokevv+2,46:xs=302:return
  17. 71 ifdx=2and(dy=2ordy=6)then dx=6:pokevv+2,6:xs=262:return
  18. 72 pokevv+16,0:ifdx=3and(dy=1ordy=7)then dx=5:pokevv+2,222:xs=222:return
  19. 73 ifxs-40<255then75
  20. 74 xy=xs-296:xs=xs-40:pokevv+16,2:pokevv+2,xy:dx=dx-1:return
  21. 75 dx=dx-1:xs=xs-40:pokevv+2,xs:return
  22. 80 pokevv+16,0:ifdx=5and(dy=1ordy=7)then dx=3:pokevv+2,142:xs=142:return
  23. 81 ifdx=6and(dy=2ordy=6)then dx=2:pokevv+2,102:xs=102:return
  24. 82 ifdx=7then dx=1:pokevv+2,62:xs=62:return
  25. 83 ifxs+40<255then85
  26. 84 xy=xs-216:xs=xs+40:pokevv+16,2:pokevv+2,xy:dx=dx+1:return
  27. 85 dx=dx+1:xs=xs+40:pokevv+2,xs:return
  28. 90 jo%=5:return
  29. 130 pokevo,15:pokewv,17:pokeat,15:pokehi,68:pokelo,149
  30. 140 for tm=1 to 100:next tm:pokewv,0
  31. 150 pokevo,15:pokewv,17:pokeat,15
  32. 160 pokewv,17:pokehi,34:pokelo,75
  33. 170 for tm=1 to 100:next tm:pokewv,0:return
  34. 180 poke781,p/40:poke782,p-40*peek(781):poke783,0:sys65520:return
  35. 190 open4,4:print#4:close4:if st and 128 then2760:rem printer on/off test
  36. 200 open3,3:open4,4:print"";:fori=0tosc:get#3,a$:print#4,a$;:next:close3:close4
  37. 210 goto2710
  38. 220 for x=1 to 37:b(x)=2:next:b(19)=1
  39. 230 nm$="peg solitaire":aa=1:gosub270:aa=0
  40. 240 for tm=1 to 2500:next tm
  41. 250 gosub1330
  42. 260 rem - puzzle screen
  43. 270 ct=fre(0):poke781,0:sys59903:print""tab((44-len(nm$))/2)""nm$"[146]":print
  44. 280 printtab(15)"[159]13   14   15":ifdy=1thengosub130
  45. 290 v=3:p=135:gosub180:printa$(b(1));u$spc(v)a$(b(2));u$spc(v)a$(b(3))
  46. 310 printtab(10)"[159]22   23   24   25   26":ifdy=2thengosub130
  47. 320 printtab(10)a$(b(4));u$spc(v)a$(b(5));u$spc(v)a$(b(6));u$spc(v)a$(b(7));
  48. 330 printu$spc(v)a$(b(8))
  49. 350 printtab(5)"[159]31   32   33   34   35   36   37":ifdy=3thengosub130
  50. 360 printtab(5)a$(b(9));u$spc(v)a$(b(10));u$spc(v)a$(b(11));
  51. 370 printu$spc(v)a$(b(12));
  52. 380 printu$spc(v)a$(b(13));u$spc(v)a$(b(14));u$spc(v)a$(b(15))
  53. 400 printtab(5)"[159]41   42   43   44   45   46   47":ifdy=4thengosub130
  54. 410 printtab(5)a$(b(16));u$spc(v)a$(b(17));u$spc(v)a$(b(18));
  55. 420 printu$spc(v)a$(b(19));u$spc(v)a$(b(20));u$spc(v)a$(b(21));
  56. 430 printu$spc(v)a$(b(22))
  57. 450 printtab(5)"[159]51   52   53   54   55   56   57":ifdy=5thengosub130
  58. 460 printtab(5)a$(b(23));u$spc(v)a$(b(24));u$spc(v)a$(b(25));
  59. 470 printu$spc(v)a$(b(26));u$spc(v)a$(b(27));u$spc(v)a$(b(28));
  60. 480 printu$spc(v)a$(b(29))
  61. 500 printtab(10)"[159]62   63   64   65   66":ifdy=6thengosub130
  62. 510 printtab(10)a$(b(30));u$spc(v)a$(b(31));u$spc(v)a$(b(32));
  63. 520 printu$spc(v)a$(b(33));u$spc(v)a$(b(34))
  64. 540 printtab(15)"[159]73   74   75":ifdy=7thengosub130
  65. 550 printtab(15)a$(b(35));u$spc(v)a$(b(36));u$spc(v)a$(b(37))
  66. 570 a=99:y=120:forx=1202to1992stepy:pokex,a:next
  67. 580 forx=1207to1997stepy:pokex,a:next
  68. 590 forx=1317to1797stepy:pokex,a:next
  69. 600 forx=1332to1812stepy:pokex,a:next
  70. 610 forx=1432to1672stepy:pokex,a:next
  71. 620 forx=1457to1697stepy:pokex,a:next
  72. 621 ifaa=0then640
  73. 622 p=972:gosub180:print"k[146]eyboard/j[146]oystick ";:poke198,0
  74. 623 getkj$:ifkj$=""then623
  75. 624 ifkj$<>"k" and kj$<>"j" then623
  76. 625 printkj$;:ifkj$="k" then di$="[159][145]i[157][157]j*k[157][157]m"
  77. 630 if aa=1 thenreturn
  78. 640 ifzz=0 or zz=1 then710
  79. 650 p=965:gosub180:print"'f1' - next     'f7' - menu";
  80. 660 b=b+1:ifb=15 thenb=0:goto660
  81. 670 getky$:ifky$=""then670
  82. 680 ky=-(ky$="[133]")-2*(ky$="[136]")
  83. 690 onkygoto1430,1330:goto670
  84. 700 rem - solved?
  85. 710 ifss=slvthenifmid$(d$,s,1)="2"thener=5:pokevv+21,0:gosub1210:goto730
  86. 720 goto765
  87. 730 poke781,24:sys59903:p=970:gosub180:print"[159]solution screen [y/n]: ";:poke198,0
  88. 740 get ky$:if ky$="" then740
  89. 750 ky=-(ky$="y")-2*(ky$="n")
  90. 760 on ky goto2120,762:goto740
  91. 762 run
  92. 765 ifkj$="k" thenp=764:gosub180:printdi$;
  93. 770 p=868:gosub180:print"[159]move #[146]";
  94. 780 p=970:gosub180:print"[159]from[146]"tab(24)"[159]to[146]";
  95. 790 p=975:gosub180:print"   ";:gosub180:print"";
  96. 791 t=0:pokevv+21,2:ifzz=0then810
  97. 800 readfr$,tu$:p=975:gosub180:printw$fr$;spc(11)tu$;:fortm=1to750:next:goto879
  98. 810 pokevv+16,0:pokevv+2,sx:pokevv+3,sy:dx=3:dy=1:xs=sx:ys=sy:goto818
  99. 811 ifjo%=5then860
  100. 812 ifpeek(197)=3thenpokevv+21,0:goto1650
  101. 815 ifpeek(197)=4thenpokevv+21,0:goto2790
  102. 818 ifkj$="k"then poke650,128:poke198,0:goto828
  103. 820 jo%=j2-peek(prt2)
  104. 821 jo%=-(jo%=1)-2*(jo%=2)-3*(jo%=4)-4*(jo%=8)-5*(jo%=16):goto830
  105. 828 getkb$:ifkb$=""then828
  106. 829 jo%=-(kb$="i")-2*(kb$="m")-3*(kb$="j")-4*(kb$="k")-5*(kb$="*")
  107. 830 onjo%gosub50,60,70,80,90:poke650,0:goto811
  108. 860 ift=1then960
  109. 870 h=dy*10+dx:p=975:gosub180:printh;:ct=fre(0)
  110. 879 ifzz=1thenh=val(fr$):dy=val(left$(fr$,1))
  111. 880 f1=h:gosub1570:fr=h:c(fr)=val(mid$(d$,fr,1))
  112. 890 fs$=mid$(d$,fr,1):iffs$="1"orfs$="3"thener=1:goto1210
  113. 900 t=1:ifzz=1thenh=val(tu$):goto970
  114. 910 p=987:gosub180:print"   ";:gosub180:print"";:goto810
  115. 960 t=0:h=dy*10+dx:ct=fre(0):p=987:gosub180:printh;
  116. 970 t1=h:gosub1570:tu=h:c(tu)=val(mid$(d$,tu,1))
  117. 990 ts$=mid$(d$,tu,1)
  118. 1000 if ts$="2" thener=2:goto1210
  119. 1010 if fs$="3" or ts$="3" thener=3:goto1210
  120. 1020 fs$="":ts$="":ct=fre(0)
  121. 1030 if abs(f1-t1)=2 or abs(f1-t1)=20 then1110
  122. 1040 er=3:goto1210
  123. 1050 rem - switch pieces
  124. 1060 c=c(tu):c(tu)=c(fr):c(fr)=c
  125. 1070 d$="":ss=.:for x=1 to 37:d$=d$+right$(str$(c(x)),1):ss=ss+c(x):next
  126. 1080 p=975:gosub180:print"   ";:p=987:gosub180:print"   ";
  127. 1090 if ft<>f1 thenp=874:gosub180:mv=mv+1:printstr$(mv);
  128. 1100 ft=t1:for x=1 to 37:b(x)=val(mid$(d$,x,1)):next:fr$="":tu$="":goto270
  129. 1110 if abs(f1-t1)=20 then1130
  130. 1120 goto1170
  131. 1130 if f1>t1 then1150
  132. 1140 h=f1+10:goto1160
  133. 1150 h=f1-10
  134. 1160 gosub1570:ifer=4then1210
  135. 1161 c(h)=1:goto1060
  136. 1170 if f1>t1 then1190
  137. 1180 h=f1+1:goto1200
  138. 1190 h=f1-1
  139. 1200 gosub1570:ifer=4then1210
  140. 1201 c(h)=1:goto1060
  141. 1210 dy=0:ifzz=1thener=6
  142. 1220 b1=1220+(er*10):poke785,188:poke786,168:pokeb1,peek(b1):b1=usr(0)
  143. 1230 er$="'from' position empty[146]":gosub1290:goto270
  144. 1240 er$="'to' position occupied[146]":gosub1290:goto270
  145. 1250 er$="invalid move[146]":gosub1290:goto270
  146. 1260 er$="incorrect 'from/to' position[146]":gosub1290:goto270
  147. 1270 er$="congratulations!!!  puzzle solved.[146]":gosub1290:return
  148. 1280 er$="puzzle solved![146]":gosub1290:return
  149. 1290 poke781,24:sys59903
  150. 1300 p=960:forx=1to5:gosub180:printtab(22-(len(er$)/2))er$;:fortm=1to500:next tm
  151. 1310 poke781,24:sys59903:fortm=1to500:nexttm,x:er$="":return
  152. 1320 rem - main menu
  153. 1330 poke53280,6:poke53281,0:zz=0:mv=0
  154. 1340 print"[147]":printtab(14)"peg solitaire[146]":print
  155. 1350 for x=1 to 16:printtab(5)chr$(x+64)". ";c$(x):next
  156. 1360 p=810:gosub180:print"select choice: ";:poke198,0
  157. 1370 get pz$:ifpz$=""then1370
  158. 1380 fori=1to16:ifpz$=mid$("abcdefghijklmnop",i,1)thenpz=asc(pz$)-64:goto1400
  159. 1390 next:goto1370
  160. 1400 printpz$;:fortm=1to500:next:d$="":b=pz
  161. 1410 if b=15thenb=1:zz=2:mv=1:print"[147]"
  162. 1420 ifpz=16 thenprint"[147]":poke53280,14:poke53281,6:end
  163. 1430 b1=1770+(b*20):poke785,188:poke786,168:pokeb1,peek(b1):b1=usr(0)
  164. 1440 ifzz=0then d1$=d$:sys rs,1710:forx=1topz:readpp$,jj$,cc$:next:gosub1480
  165. 1450 for x=1 to 37:b(x)=val(mid$(d$,x,1)):c(x)=b(x):next
  166. 1460 nm$="":poke53280,8:poke53281,6:nm$=c$(b):ss=.:ifzz=0thenprint"[147]"
  167. 1470 goto270
  168. 1480 print"[147]":s1$=""+c$(pz)+"[146]":printtab(15-(len(c$)/2));s1$
  169. 1490 print" in order to solve this puzzle, remove"
  170. 1500 s1$=""+pp$+"[146]":s2$=""+jj$+"[146]"
  171. 1510 print" "s1$;" pieces in ";s2$;" moves leaving the last":s1$=""
  172. 1520 s1$=""+cc$+"[146]":print" playing piece in position ";s1$;".":s1$=""
  173. 1530 print:print" press 'f1' for auto-solve; 'f7' to":print" end."
  174. 1540 p=890:gosub180:print"press <return> to begin"
  175. 1550 getky$:ifky$<>chr$(13)then1550
  176. 1560 ft=0:return
  177. 1570 ifh<=15thenifh>=13thenh=h-12:return
  178. 1580 ifh<=26thenifh>=22the